COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 MacLisp portion of the E/MacLisp Interface.
C00005 00003	 Mailbox Manipulation Routines
C00007 00004	 Storage for Mail routines
C00008 ENDMK
C⊗;
;;; MacLisp portion of the E/MacLisp Interface.
;;;
;;; An SFA/MAIL based system for communicating with
;;; an unstructured, standard text editor.
;;;
;;;	Mail
;;;	wd1:	Job# sending message
;;;	wd2:	type of message
;;;		0,,1:	SEXPs
;;;		0,,2    control (meta) chars to follow (E macro format)
;;;		0,,4:   Ready for answer
;;;		0,,10:  not ready for answer
;;;		0,,100: initiating a conversation
;;;		1,,0:   Continuation needed
;;;		2,,0:	Short (fits in the next =30 words, ends with null byte
;;;			       or falls off)
;;;		
;;;	wd3:	-length (in bytes?),,address of block

(declare (mapex t)
	 (fasload util fas dsk (aid rpg))
	 (special em:jobnum)
	 (fixnum em:jonum))

(defun em:negotiate (n)
 (em:wait-for-mail)
 (cond ((eq (em:jobname) 'E)
	(em:acknowledge))
       (t (error 'fail-act '|Bad jobname|))))
 
(defun em:toplevel ()
       (let ((em:sfa (sfa-create)))
	    (em:negotiate)
	    (do ((message-type (em:getmail)
			       (em:getmail))
		 (sexp))
		(())
		(*catch 'em:toplevel
			(caseq message-type
		       (sexps
			(em:eval-file em:sfa))
		       (control
			(em:eval-control-file em:sfa)))
		       
(defun em:eval-file (sfa)
 (let ((eof (ncons ())))
      (do ((form (read sfa eof)
		 (read sfa eof)))
	  ((eq form eof) t)
	  (print (eval form) sfa))))

(defun em:eval-control-file (sfa)
 (do ((char (tyi sfa -1)
	    (tyi sfa -1)))
     ((= char -1) t)
     (caseq char
	((#o302 #o342)
	 (break ↑B t))
	((#o307 #o347)
	 (*throw 'em:toplevel t))
	)))
;;; Mailbox Manipulation Routines
;;;	Mail
;;;	wd1:	Job# sending message
;;;	wd2:	type of message
;;;		0,,0	Short (fits in the next =30 words, ends with null byte
;;;			       or falls off)
;;;		0,,1:	SEXPs
;;;		0,,2    control (meta) chars to follow (E macro format)
;;;		0,,4:   Ready for answer
;;;		0,,10:  not ready for answer
;;;		0,,100: initiating a conversation
;;;		1,,0:   Continuation needed
;;;		
;;;	wd3:	-length (in bytes?),,address of block

(lap em:getmail subr)

	(args em:mailbox (nil . 0))

	(mail 2 mailbox)	;SRCV
	(jrst 0 false)
	(move a mailbox)	;get the jobnum
	(came a jobnum)		;correct one?
	(jrst 0 false)
	(move a (+ mailbox 1)) ;get type
	(tlne a 1)
	(jrst 0 short)
	(hrrz tt a)
ret1	(jsp t fxcons)		;make a number
	(popj p)
short	(movei tt -1)
	(jrst 0 ret1)

true	(movei a 't)
	(popj p)
false	(movei a 'nil)
	(popj p)

(entry em:mailtype subr)
(args em:mailtype (nil . 0))
;;; Storage for Mail routines

mailbox	(block 32.)	;mail